perm filename ERROR.OLD[PUB,TES] blob
sn#150106 filedate 1975-03-11 generic text, type T, neo UTF8
00100 BEGOF("ERROR")
00200 COMMENT
00300
00400 *** Variations at Different Sites ***
00500
00600 CALLEDITOR works only if compiler-editor linkages are available, and
00700 is different at each site.
00800
00900 LOSERR is used at sites with a pre-April-74 SAIL lacking the
01000 three-argument form of USERERR.
01100
01200 ***
01300
01400 Pass One Error Handler, first done sans-SAIL by Rich Johnsson.
01500 Whenever possible, PUB and SAIL errors are trapped by the procedure
01600 REPORT. However, SAIL requires that REPORT be a SIMPLE PROCEDURE, so
01700 to avoid recursion, there are times that REPORT is disabled and
01800 NREPORT or USERERR is used instead. Furthermore, before PUB
01900 initiallization is complete, REPORT would not work, so EARLYWARNING
02000 (which calls USERERR) is used for errors instead of the usual WARNN
02100 (which calls REPORT).
02200
02300 WARN(SHORT, LONG) puts the error message LONG on the terminal. IF
02400 SHORT = "=", the same message is put in the right margin in
02500 DEBUGmode., if SHORT = NULL, no message goes in the right margin.,
02600 else, SHORT goes in the right margin.
02700
02800 Actually, WARN(SHORT,LONG) is a macro which expands to
02900 WARNN(UNIQUEOWNINTEGERVARIABLE, SHORT, LONG) so that there is a place
03000 to remember the occurrence of "Q" and "A" responses.
03100
03200 ;
03300
03400 EXTERNAL INTEGER !ERRP! ;
03500
03600 PROCEDURES
00100 PUBLIC SIMPLE PROCEDURE ERROR! ;$"#
00200 BEGIN "ERROR!"
00300 TES 8/20/74 INTERCEPT SAIL ERRORS ;
00400 !ERRP! ← LOCATIONOFERROR ← LOCATION(REPORT) ;
00500 COMMENT THE VARIABLE GETS AROUND A SAIL BUG FIXED BY RHT SEP 74;
00600 END "ERROR!" ;
00100 IFK CMUVER OR SAILVER THENK
00200 RKJ: 6-25-74 Do your own USERERR;
00300
00400 PRIVATE PROCEDURE CALLEDITOR(STRING EDNAME) ;$"#
00500 BEGIN TES 8/20/74 ADDED SAIL CASES ;
00600 SAFE INTEGER ARRAY B[0:5];
00700 STRING FILE;
00800 INTEGER LINE,PAGE,F,E,P;
00900 FILE←INCHWL;
01000 IF FULSTR(FILE)
01100 THEN LINE←PAGE←0
01200 ELSE
01300 BEGIN "DEFAULTFILE"
01400 FILE←THISFILE;
01500 LINE←CVASC(SRCLINE) LOR 1;
01600 PAGE←CVD(SRCPAGE);
01700 END "DEFAULTFILE";
01800 B[0]←CVSIX("SYS");
01900 B[1]←CVSIX(EDNAME);
02000 B[2]←B[3]←B[4]←B[5]←0;
02100 F←CVFIL(FILE,E,P);
02200 START!CODE "RUNEDITOR"
02300 MOVE '14,F; MOVE '13,E; MOVE '11,P; MOVE '16,PAGE; MOVE '15,LINE;
02400 MOVE 1,B; HRLI 1,1;
02500 IFC CMUVER THENC CALLI 1,-'22; ELSEC CALLI 1,'35; ENDC RKJ: 7-Nov-74 and 6-Feb-75;
02600 JRST 4,0;
02700 END "RUNEDITOR";
02800 END "CALLEDITOR";
02900 ENDC
00100 PUBLIC SIMPLE PROCEDURE DUSERERR ;$"#
00200 BEGIN "DUSERERR"
00300 STRING USER!MESSG;
00400 PASS;
00500 USER!MESSG ← E(NULL,NULL);
00600 IF ON THEN WARN("=",USER!MESSG);
00700 END "DUSERERR";
00100 PUBLIC STRING SIMPLE PROCEDURE EARLYWARNING(STRING MESSG) ;$"#
00200 USERERR(0,1,MESSG) ; TES 8/20/74 USED BEFORE INITIALLIZATION IS COMPLETE ;
00100 PUBLIC STRING SIMPLE PROCEDURE ERRLINE ;$"#
00200 RETURN(IF EQU(MAINFILE, THISFILE) THEN SRCLINE
00300 ELSE THISFILE&SP&SRCLINE) ;
00100 PUBLIC SIMPLE PROCEDURE IMPOSSIBLE(STRING WHERE) ;$"#
00200 WARN("=","Impossible CASE index in " & WHERE &
00300 " at " & SOMEINPUT);
00100 IFSITE TENEX THENK
00200
00300 PRIVATE SITE(TENEX) SIMPLE STRING PROCEDURE INCHWL ;$"#
00400 BEGIN
00500 STRING S ; INTEGER C ;
00600 S ← NULL ;
00700 DO
00800 BEGIN
00900 C ← PBIN ;
01000 IF C = CTLA THEN
01100 IF NULSTR(S) OR EQU(S[∞-3 TO ∞], CRLF&"##") THEN
01200 ELSE BEGIN
01300 TES 8/23/74 ↑A ECHOES ANYWAY, SO FORGET PBOUT("\") ;
01400 PBOUT(S[∞ FOR 1]) ;
01500 S ← S[1 TO ∞-1] ;
01600 END
01700 ELSE IF C = CTLS THEN OUTSTR(" =" & EOL & "#" & S)
01800 ELSE IF C = EOL OR C = ALTMODE THEN RETURN(S)
01900 ELSE IF C = CTLV THEN S ← S & PBIN
02000 ELSE IF C=RUBOUT THEN
02100 BEGIN
02200 OUTSTR(" XXX" & EOL & "#") ;
02300 S ← NULL ;
02400 END
02500 ELSE IF C = LF THEN TES 8/23/74 ;
02600 IF LAST<4 THEN RETURN(S)
02700 ELSE BEGIN OUTSTR(CR&"##") ; S ← S & (CRLF&"##") END
02800 ELSE IF C = CTLQ THEN TES 8/23/74 ;
02900 BEGIN
03000 OUTSTR("←"&CRLF&"#") ;
03100 WHILE FULSTR(S) AND NOT EQU(S[∞-3 TO ∞],CRLF&"##") DO S←S[1 TO ∞-1] ;
03200 IF FULSTR(S) THEN OUTSTR("#") ;
03300 END
03400 ELSE S ← S & C ;
03500 END UNTIL FALSE ;
03600 END "INCHWL" ;
03700
03800 ENDC
00100 IFK ITSVER THENK COMMENT THEIR USERERR HAS 3 ARGS ;
00200 PRIVATE SIMPLE PROCEDURE LOSERR(INTEGER RSP) ;$"#
00300 BEGIN
00400 DEFINE !BREAK = " '45000000000" ;
00500 EXTERNAL INTEGER JOBSA ;
00600
00700 IF RSP="X"
00800 THEN START!CODE !BREAK '16,'40000 END
00900 ELSE IF RSP="S"
01000 THEN START!CODE MOVE 1,JOBSA; JRST (1) END
01100 ELSE IF RSP="D" THEN START!CODE !BREAK '16,'3000000 END;
01200 END "LOSERR";
01300 ENDC
00100 PRIVATE SIMPLE INTEGER PROCEDURE NREPORT(INTEGER LOC; STRING MESG, RSP) ;$"#
00200 RETURN(RSP + 3 LSH 18) ; TES 8/20/74 CALLED BY REPORT ;
00100 PUBLIC SIMPLE INTEGER PROCEDURE REPORT (INTEGER LOC; STRING MESG, RSP) ;$"#
00200 BEGIN "REPORT" RKJ 6/25/74 TES 8/20/74 ;
00300 COMMENT SAIL CALLS REPORT(LOC,CRLF&MESG&CRLF,NULL),
00400 WARN CALLS REPORT(0,MESG,NULL|"A"),
00500 OTHERS CALL REPORT(0,MESG|NULL,RSP) ;
00600 EXTERNAL INTEGER !JBSA,!JBDDT;
00700 INTEGER CHAR;
00800 DEFINE CLRBFI= [START!CODE TTCALL '11,0 END];
00900 IF LOC=0 AND NOT SWDBACK THEN OUTSTR(CRLF) ; SWDBACK←TRUE;
01000 IF FULSTR(MESG) THEN BEGIN OUTSTR(MESG); IF LOC=0 THEN OUTSTR(CRLF) END ;
01100 IF NOT ERRLF THEN
01200 IF (CHAR←INCHRS)=LF
01300 THEN ERRLF←TRUE;
01400 IF LOC THEN OUTSTR(
01500 "This is a SAIL error - Probably a PUB bug. Called from location "&CVOS(RH(LOC))&CRLF) ;
01600 IF NOT ON THEN OUTSTR("In the false part of a conditional"&CRLF) ;
01700 OUTSTR("Line/Page "&ERRLINE&"/"&SRCPAGE&"["&MACLINE&"]"&CRLF) ;
01800 CHAR ← RSP ;
01900 IF NOT ERRLF THEN
02000 WHILE TRUE DO
02100 BEGIN "ERRLOOP"
02200 IF NOT CHAR THEN
02300 BEGIN
02400 OUTCHR("↑");
02500 IFC TENEX THENC CLRBUF ELSEC CLRBFI ENDC ;
02600 CHAR ← INCHRW ;
02700 IF "a" LEQ CHAR LEQ "z" THEN CHAR ← CHAR LAND '137 ;
02800 END ;
02900 IF CHAR=CR THEN BEGIN INCHWL; CHAR←0; DONE END ELSE
03000 IF CHAR="C" OR CHAR='37 THEN BEGIN CHAR←0; DONE END ELSE
03100 IF CHAR=LF THEN BEGIN ERRLF←TRUE; CHAR←0; DONE END ELSE
03200 IF CHAR="X" THEN DONE ELSE
03300 IF CHAR="S" THEN DONE ELSE
03400 IF CHAR="D" THEN
03500 IFC TENEX THENC DONE ELSE ELSEC
03600 BEGIN
03700 IF !JBDDT NEQ 0
03800 THEN DONE
03900 ELSE OUTSTR(CRLF&"No DDT"&CRLF);
04000 END ELSE
04100 ENDC
04200 IFC SAILVER OR CMUVER THENC
04300 IF CHAR="E" THEN CALLEDITOR(IFC SAILVER THENC "SOS" ELSEC "LINED" ENDC) ELSE
04400 ENDC
04500 IFC SAILVER THENC
04600 IF CHAR="T" THEN CALLEDITOR("E") ELSE
04700 ENDC
04800 IF CHAR="P" THEN
04900 BEGIN TES: PUB INTERACTIVE DEBUGGER ;
05000 INTEGER LASTWAS, TEXTWAS, BRCWAS, ONWAS ;
05100 LASTWAS←LAST ; TEXTWAS←TEXTMODE ; ONWAS←ON ; ON←TRUE ;
05200 OUTSTR(CRLF&"= = = = ="&CRLF) ;
05300 !ERRP! ← 0 ; COMMENT PREVENT RECURSION ;
05400 SWICH("START PUB!DEBUG END;;" &
05500 (IF NOT TEXTMODE THEN CRLF&TB&TB
05600 ELSE RCBRAK), -1, 0) ; TES 8/23/74;
05700 TEXTMODE ← 0 ; TES 8/23/74 ;
05800 PASS ; STATEMENT ;
05900 !ERRP! ← LOCATIONOFERROR ;
06000 OUTSTR("= = = = ="&CRLF) ;
06100 ON ← ONWAS ;
06200 IF TEXTWAS THEN
06300 BEGIN
06400 WHILE LAST>LASTWAS DO SWICHBACK ;
06500 EMPTYTHIS ; EMPTYTHAT ;
06600 TEXTMODE ← TRUE ; BRC ← BRCWAS ;
06700 END ;
06800 END
06900 ELSE
07000 IF CHAR = "Q" AND NOT LOC THEN
07100 BEGIN LOC←TRUE; OUTSTR(CRLF) ; DONE END ELSE
07200 IF CHAR = "A" AND NOT LOC THEN
07300 BEGIN
07400 LOC←TRUE;
07500 OUTSTR(IF RSP="A" THEN "AUTO-CONTINUE"&CRLF ELSE CRLF) ;
07600 DONE ;
07700 END ELSE
07800 IF CHAR = "?" THEN
07900 BEGIN
08000 OUTSTR("Reply" & CRLF &
08100 "<CR> to continue," & CRLF &
08200 "<LF> to continue automatically from all messages," & CRLF &
08300 """A"" to continue automatically from this message,"& CRLF &
08400 """Q"" to quiet this message," & CRLF &
08500 """P"" to enter PUB debug loop, " & CRLF
08600 );
08700 IFC NOT TENEX THENC IF !JBDDT NEQ 0 THEN ENDC
08800 OUTSTR("""D"" to enter DDT, ") ;
08900 OUTSTR(
09000 IFC SAILVER THENC
09100 """E"" or ""T"" to EDIT, "&
09200 ELSEC
09300 IFC PARCVER THENC
09400 """E"" to EDIT, "&
09500 ENDC ENDC
09600 """X"" to exit, ""S"" to start over"&CRLF);
09700 END ELSE OUTSTR(" ? FOR HELP"&CRLF) ;
09800 CHAR ← 0 ;
09900 END "ERRLOOP" ;
10000 IF LOC OR NOT CHAR THEN RETURN(CHAR + 3 LSH 18)
10100 ELSE BEGIN "BUGGY"
10200 !ERRP! ← LOCATION(NREPORT) ; COMMENT SIMPLE PROCEDURES CAN'T RECURSE ;
10300 IFC ITSVER THENC
10400 LOSERR(CHAR) ;
10500 ELSEC
10600 USERERR(0, 1, NULL, CHAR) ;
10700 ENDC
10800 !ERRP! ← LOCATIONOFERROR ;
10900 RETURN(0) ;
11000 END "BUGGY" ;
11100 END "REPORT";
00100 PUBLIC STRING SIMPLE PROCEDURE SOMEINPUT ;$"#
00200 RETURN(SP&THISWD&SP&
00300 (IF THATISFULL THEN LIT!ENTITY&LIT!TRAIL ELSE NULL)&INPUTSTR[1 TO 80]);
00100 PUBLIC STRING PROCEDURE TYPEIN ;$"#
00200 BEGIN
00250 RKJ: 6-FEB-75 MODS FOR AUTOCRLF;
00300 IF NOT ON THEN RETURN (NULL); RKJ: 5-10-74 ;
00400 IF (NOT SWDBACK) AND AUTOCRLF THEN BEGIN OUTSTR(CRLF) ; SWDBACK ← TRUE END ;
00500 IF AUTOCRLF THEN OUTSTR("#") ;
00600 RETURN(INCHWL) ;
00700 END "TYPEIN" ;
00100 PUBLIC STRING SIMPLE PROCEDURE WARNN(REFERENCE BOOLEAN QUIETER; STRING SHORT!VERSION,LONG!VERSION) ;$"#
00200 BEGIN "WARN"
00300 COMMENT USUALLY CALLED BY WARN(SHORT, LONG) -- DEFINED AS:
00400 BEGIN OWN INTEGER <NEWNAME> ., WARNN(<NEWNAME>, SHORT, LONG) END ;
00500 COMMENT MAYBE THERE WAS A "Q" RESPONSE BEFORE ;
00600 IF QUIETER="Q" OR NULSTR(LONG!VERSION) THEN
00700 ELSE IF !ERRP! THEN QUIETER ← RH(REPORT(0, LONG!VERSION, QUIETER))
00800 ELSE USERERR(0, 1, LONG!VERSION) ; COMMENT PREVENT RECURSION ;
00900 IF DEBUG AND MESGS<MESSMAX AND FULSTR(SHORT!VERSION) THEN
01000 MESGSARR[MESGS←MESGS+1] ← IF SHORT!VERSION = "=" THEN LONG!VERSION ELSE SHORT!VERSION ;
01100 RETURN(NULL) ;
01200 END "WARN" ;
00100 FINISHED
00200
00300 ENDOF("ERROR")